home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / pubdom.tar / pubdom / rbj / mphase < prev    next >
Text File  |  1990-05-30  |  3KB  |  58 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ MPHASE - Moon Phase:   Put date on stack, MPHASE
  3. @ WJQ 5/27/90
  4. @ RBJ 5/29/90, Notes:  Origin at Upper Left, X to Right, Y Downward
  5. @     5/30/90    Circle Radius 26, Origin (64,28)
  6. @     
  7. \<<                                         @ Start of MPHASE
  8.   \<<                                       @ Start Local Function "p"
  9.                                             @ Radius, Ycoord, MoonFrac
  10.     \<<                                     @ Start Function "h" within "p"
  11.       \-> rfrac yc rl rr                    @ Rad frac, Y, Rleft, Rright 
  12.       \<<                                   @  Center at X = 64 pixels
  13.         rfrac rl * 64 + R\->B yc R\->B      @ Start (rfrac*rl+64, yc) 
  14.         2 \->LIST                           @ Convert to pixel list
  15.         rfrac rr * 64 + R\->B yc R\->B      @ End   (rfrac*rr+64, yc) 
  16.         2 \->LIST                           @ Convert to pixel list
  17.         LINE                                @ Draw Line
  18.       \>> 
  19.     \>>                                     @ End of Function "h"
  20.  
  21.     \-> rad yc mfrc h                       @ Guts of "p": rad, y, frac, "h"
  22.     \<< 
  23.       IF   mfrc .5 <                        @ Test Moon Fraction
  24.       THEN mfrc 360 * COS rad *             @ Left radius
  25.            rad                              @ Right Pixel
  26.       ELSE rad NEG                          @ Same if test false
  27.            mfrc .5 - 360 * COS rad *        @ 
  28.       END 
  29.       \-> l r                               @ Grab Left, Right Radii
  30.       \<< 1 0                               @ x: fraction of Radius 
  31.         FOR x                               @ Loop from 1.00 to 0.000
  32.           x ACOS SIN DUP                    @ Moon Radius at "Latitude"
  33.           yc x rad * + l r   h EVAL         @ Lower Line 
  34.           yc x rad * - l r   h EVAL         @ Upper Line 
  35.           rad INV NEG                       @ Decrement x by (1/rad)
  36.         STEP
  37.       \>>                                   @ End of prgm with local l, r
  38.     \>>                                     @ End of functional part of "p"
  39.   \>>                                       @ End of local function "p"
  40.  
  41.   \-> d p                                   @ Store date & local function "p"
  42.                                             @ MAIN Program
  43.   \<< -31 SF ERASE                          @ Clear graphic screen
  44.     { #0d #0d } PVIEW                       @ Circle at (64,28), R = 26
  45.     { #64d #28d } #26d 0 360 ARC            @ Point, Radius, Angles ARC
  46.     26 28                                   @ Radius, Y coord (Used by p EVAL)
  47.     1.121975 d DDAYS                        @ Days since Jan 12, 1975
  48.     .8 +                                    @ Add .8 days (7:20 PM ?)
  49.     1440 *                                  @ Convert to minutes
  50.     42532 / FP                              @ Find fraction of period (orbit)
  51.     p EVAL                                  @ Run the local function above
  52.     PICT PICT RCL NEG                       @ Invert Graphics
  53.     { #0d #0d } SWAP REPL 
  54.     7 FREEZE                                @ Hold Screen
  55.     d                                       @ Put date back on stack 
  56.   \>> 
  57. \>>
  58.